home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
pbc22b.zip
/
PBC$BAS.ZIP
/
PSORTD.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-01
|
2KB
|
60 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
' QuickSort derived from "partition sort" algorithm given in
' "Algorithms & Data Structures" by Niklaus Wirth, 1986
TYPE Partition
Lft AS INTEGER
Rht AS INTEGER
END TYPE
SUB PSortD (Ptr%(), Array() AS DOUBLE, Elements%)
DIM x AS DOUBLE
DIM SortStack(1 TO 16) AS Partition
S% = 1
SortStack(1).Lft = 1
SortStack(1).Rht = Elements%
DO
L% = SortStack(S).Lft
R% = SortStack(S).Rht
S% = S% - 1
DO
i% = L%
j% = R%
x = Array(Ptr%((L% + R%) \ 2))
DO
WHILE Array(Ptr%(i%)) < x
i% = i% + 1
WEND
WHILE x < Array(Ptr%(j%))
j% = j% - 1
WEND
IF i% <= j% THEN
SWAP Ptr%(i%), Ptr%(j%)
i% = i% + 1
j% = j% - 1
END IF
LOOP UNTIL i% > j%
IF j% - L% < R% - i% THEN
IF i% < R% THEN
S% = S% + 1
SortStack(S%).Lft = i%
SortStack(S%).Rht = R%
END IF
R% = j%
ELSE
IF L% < j% THEN
S% = S% + 1
SortStack(S%).Lft = L%
SortStack(S%).Rht = j%
END IF
L% = i%
END IF
LOOP UNTIL L% >= R%
LOOP WHILE S%
END SUB